perm filename PASS3.F4[P11,LCS] blob sn#341657 filedate 1978-03-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	CPASS3     PASS 3 MAIN PROGRAM  
C00012 ENDMK
C⊗;
CPASS3     PASS 3 MAIN PROGRAM  
C    *** MUSIC V ***     
C     DATA SPECIFICATION 
      INTEGER PEAK
      DIMENSION T(50),TI(50),ITI(50)   
      COMMON I(11000) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,NRSOR,IPEAK
	DIMENSION IHD(1)
	EQUIVALENCE (IHD,P(1))
CC*******      DATA IIIRD/Z5EECE66D/     
      DATA IIIRD/976545367/     
C  SET I ARRAY =0 (7/10/69)
      DATA I/11000*0/,I(4)/12800/
C**************
C     INIALIZATION OF PIECE     
C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
      I(7)=IIIRD  
      IP9=IP(9)   
      PEAK=0      
      NRSOR=0     
	IPEAK=0
C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
CC*******    NREAD = 3   
CC*******    NWRITE = 2  
      NREAD=21
C   PDP DSK1=DEV.21
      NWRITE=1
C   PDP DSK=DEV.1
      REWIND NREAD
      REWIND NWRITE      
      TYPE 401  
      ACCEPT 501  ,FLNM,IDSK
C  TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK.
      IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21'
      CALL IFILE(21,FLNM)
      IF(IDSK.NE.0)GO TO 601
CC    J='MUSAA'
	J='TEST'
      CALL PUTFILE(J)
C  IF IDSK=0, SAMPLES WILL BE WRITTEN ON DSK (TEST.SND)
      IDSK=0
	IHD(1)="525252525252
	IHD(2)=I(4)
C I(4)=SRATE
	IHD(3)=0
C  0=12-BIT
C (4)NCHNS←1 OR 2
	IHD(4)=I(8)+1
	IF(IHD(4).EQ.0)IHD(4)=1
C (5)MAXAMP (FLTING PT.)  (6)=NUM. OF SAMPLES
CC	P(55)=PEAK
	IHD(6)=0
	CALL FASTOU(IHD,128)
C THE HEADER (SUCH AS IT IS)
      GO TO 701  
601   IDSK=-1
401   FORMAT(' TYPE FILE NAME'/)
501   FORMAT(A5,I)
C**** ABOVE FOR PDP10 IO ********
701   SCLFT=IP(12)
      I(2)=IP(4)  
      MS1=IP(7)   
      MS3=MS1+(IP(8)*IP(9))-1   
      MS2=IP(8)   
      I(4)=IP(3)  
      MOUT=IP(10) 
C     INITIALIZATION OF SECTION 
5     T(1)=0.0    
      DO 220N1=MS1,MS3,MS2
 220  I(N1)=-1    
      DO 221N1=1,IP9      
 221  TI(N1)=90909.    
C     MAIN CARD READING LOOP    
  204 CALL DATA (NREAD)  
      IF(P(2)-T(1))200,200,244  
 200  IOP=P(1)    
      IF(IOP)201,201,202 
 201  CALLERROR(1)
      GO TO 204     
 202  IF(IP(1)-IOP)201,203,203  
 203  GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP    
 11   IVAR=P(3)   
      IVARE=IVAR+I(1)-4  
      DO  297 N1=IVAR,IVARE      
      IVARP=N1-IVAR+4    
 297  I(N1)=P(IVARP)     
      GO TO 204     
 3    IGEN=P(3)   
      IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION  GO TO (281,282,283,284,285),IGEN   
 281  CALLGEN1    
      GO TO 204     
 282  IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
      CALLGEN2    
      GO TO 204     
CCC 283  CALLGEN3    
CCC   GO TO 204     
CCC 284  CALLGEN4    
CCC   GO TO 204     
CCC 285  CALLGEN5    
CCC   GO TO 204     
 4    IVAR=P(3)   
      IVARE=IVAR+I(1)-4  
      DO 296N1=IVAR,IVARE 
      IVARP=N1-IVAR+4    
 296  I(N1+100)=P(IVARP)*SCLFT  
      GO TO 204     
    6 CALL FROUT3(IDSK)
      STOP 
C     ENTER NOTE TO BE PLAYED   
 1    DO 230N1=MS1,MS3,MS2
      IF(I(N1)+1)230,231,230    
 230  CONTINUE    
      CALLERROR(2)
      GO TO 204     
 231  M1=N1
      M2=N1+I(1)-1
      M3=M2+1     
      M4=N1+IP(8)-1      
      DO 232N1=M1,M2      
      M5=N1-M1+1  
 232  I(N1)=P(M5)*SCLFT  
      I(M1  )=P(3)
      DO 233N1=M3,M4      
 233  I(N1)=0     
      DO 235N1=1,IP9      
      IF(TI(N1)-90909.)235,234,235   
 234  TI(N1)=P(2)+P(4)   
      ITI(N1)=M1  
      GO TO 204     
 235  CONTINUE    
      CALLERROR(3)
      GO TO 204     
C     DEFINE INSTRUMENT  
 2    M1=I(2)     
      M2=IP(5)+IFIX(P(3))
      I(M2)=M1    
  218 CALL DATA (NREAD)  
      IF(I(1)-2)210,210,211     
 210  I(M1)=0     
      I(2)=M1+1   
      GO TO 204     
 211  I(M1)=P(3)  
      M3=I(1)     
      I(M1+1)=M1+M3-1    
      M1=M1+2     
      DO 217N1=4,M3
      M5=P(N1)    
      IF(M5)212,213,213  
 212  IF(M5+100)300,301,301     
 300  I(M1)=-IP(2)+(M5+101)*IP(6)      
      GO TO 216     
 301  I(M1)=-IP(13)+(M5+1)*IP(14)      
      GO TO 216     
 213  IF(M5- 100 )214,214,215   
 214  I(M1)=M5    
      GO TO 216     
 215  I(M1)=M5+26262     
CCC 215  I(M1)=M5+262144    
C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
 216  M1=M1+1     
 217  CONTINUE    
      GO TO 218     
C     PLAY TO ACTION TIME
 244  T(2)=P(2)   
 250  TMIN=90909.      
      IREST=1     
      DO 241N1=1,IP9      
      IF(TMIN-TI(N1))241,241,240
 240  TMIN=TI(N1) 
      MNOTE=N1    
 241  CONTINUE    
      IF(90909.-TMIN)251,251,243     
 243  IF(TMIN-T(2))245,245,246  
 245  T(3)=TMIN   
      GO TO 260     
 246  T(3)=T(2)   
      GO TO 260     
 247  IF(T(1)-T(2))249,200,200  
 249  TI(MNOTE)=90909. 
      M2=ITI(MNOTE)      
      I(M2)=-1    
      GO TO 250     
C     SETUP REST  
 251  T(3)=T(2)   
      IREST=2     
      GO TO 260     
C     PLAY 
 260  ISAM=(T(3)-T(1))*FLOAT(I(4))+.5  
      T(1)=T(3)   
      IF(ISAM)247,247,266
 266  IF(ISAM-IP(14))262,262,263
 262  I(5)=ISAM   
      ISAM=0      
      GO TO 264     
 263  I(5)=IP(14) 
      ISAM=ISAM-IP(14)   
 264  IF(I(8))290,290,291
 290  M3=MOUT+I(5)-1     
      MSAMP=I(5)  
      GO TO 292     
 291  M3=MOUT+(2*I(5))-1 
      MSAMP=2*I(5)
 292  DO 267N1=MOUT,M3    
 267  I(N1)=0     
      GO TO (268,265),IREST
 268  DO 270NS1=MS1,MS3,MS2      
      IF(I(NS1)+1)271,270,271   
C     GO THROUGH UNIT GENERATORS IN INSTRUMENT
 271  I(3)=NS1    
      IGEN=IP(5)+I(NS1)  
      IGEN=I(IGEN)
 272  I(6)=IGEN   
CC*****    IF(I(IGEN)-101)293,294,294
CC***** 293  CALLSAMGEN(I)      
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC*****      GO TO 295     
 294  CALLFORSAM  
 295  IGEN=I(IGEN+1)     
      IF(I(IGEN))270,270,272    
 270  CONTINUE    
 265  CALL SAMOUT(IDSK ,MSAMP)
      IF(ISAM)247,247,266
      END